home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
EnigmA Amiga Run 1997 July
/
EnigmA AMIGA RUN 20 (1997)(G.R. Edizioni)(IT)[!][issue 1997-07 & 08][EAR-CD IV].iso
/
earcd
/
dev
/
amos
/
moreusel.lha
/
Earth.AMOS
/
Earth.amosSourceCode
Wrap
AMOS Source Code
|
1997-04-18
|
5KB
|
174 lines
Set Buffer 120
NAM$=Command Line$
Screen Open 0,320,256,8,0
Curs Off : Flash Off : Paper 0 : Pen 1 : Cls
For A=1 To 7 : Colour A,A*$222 : Next
Double Buffer : Autoback 0
AX=0 : AY=0 : AZ=65 : PIC=0
DZ=4000
MAS=1100
Dim SBUF$(MAS)
T=0 : TIM=0 : ST1=32 : ST2=32 : ST3=32
Repeat
Screen Swap : Wait Vbl
Extension_8_121C 0,0
Extension_8_1138 AX,AY,AZ
Extension_8_1122 0,0,DZ
Extension_8_1152
Extension_8_121C 0,1
If TIM Then Dec TIM : If TIM=0 Then Inc T
If T=0
If TIM
Add AX,1
End If
Extension_8_121C 0,2
Extension_8_1258
Add WX,4
Gosub DTEARTH
If DZ>300
Add DZ,-20
Else
If TIM=0 : TIM=100 : End If
If TIM=80 : ST1=16 : End If
If TIM=70 : ST2=32 : End If
If TIM=60 : ST1=8 : End If
If TIM=50 : ST2=16 : End If
If TIM=40 : ST1=4 : End If
If TIM=30 : ST2=8 : End If
If TIM=20 : ST1=2 : End If
If TIM=10 : ST2=4 : End If
End If
End If
If T=1
If TIM=0 : TIM=100 : ST1=32 : ST2=64 : End If
If TIM=80 : ST2=32 : End If
If TIM=60 : ST1=16 : End If
If TIM=40 : ST2=16 : End If
If TIM=20 : ST1=8 : End If
Extension_8_121C 0,2
Extension_8_1258
Add WX,3
Add AX,2
Add AY,1
Gosub LINEEARTH
End If
If T=2
If TIM=0 : TIM=500 : End If
Extension_8_121C 0,2
Extension_8_1258
Add WX,2
Add AX,3
Add AY,2
Add AZ,1
Gosub AREAEARTH
End If
If T=3
Extension_8_121C 0,2
Extension_8_1258
Add WX,3
Add AX,2
Add AZ,1
Gosub AREAEARTH
Add DZ,50
End If
If NAM$<>"" Then Save Iff NAM$+ Extension_8_0EB8(PIC,3) : Inc PIC
Until DZ=4000
End
DTEARTH:
A=0
For Y=-248 To 248 Step ST1
Add A,ST1
If(A mod 32)=0 Then ST=ST2 Else ST=64
For X=WX To 1023+WX Step ST
R= Extension_8_1114(Y,100)
XX= Extension_8_1106(X,R) : ZZ= Extension_8_1114(X,R)
YY= Extension_8_1106(Y,100)
Z2= Extension_8_11C4(XX,YY,ZZ)-DZ
C=(100-Z2)/26
If C>-1
X2= Extension_8_1168 +160
Y2= Extension_8_1184 +128
If Extension_8_039E(X2,Y2)<C
Extension_8_0388 X2,Y2,C
End If
End If
Next
Next
Return
LINEEARTH:
For Y=-256 To 256 Step ST1
OX1=0 : OY1=0 : OX2=0 : OY2=0
For X=WX To 1024+WX Step ST2
R= Extension_8_1114(Y,100)
XX= Extension_8_1106(X,R) : ZZ= Extension_8_1114(X,R)
YY= Extension_8_1106(Y,100)
Z2= Extension_8_11C4(XX,YY,ZZ)-DZ
X2= Extension_8_1168 +160
Y2= Extension_8_1184 +128
If OX1 or OY1
If Z2>0
Extension_8_1016 X2,Y2 To OX1,OY1,1,1
Else
Extension_8_1016 X2,Y2 To OX1,OY1,2,2
End If
End If
OX1=X2 : OY1=Y2
If Y<>-248
R= Extension_8_1114(Y-ST1,100)
XX= Extension_8_1106(X,R) : ZZ= Extension_8_1114(X,R)
YY= Extension_8_1106(Y-ST1,100)
Z2= Extension_8_11C4(XX,YY,ZZ)-DZ
X2= Extension_8_1168 +160
Y2= Extension_8_1184 +128
If Z2>0
Extension_8_1016 X2,Y2 To OX1,OY1,1,1
Else
Extension_8_1016 X2,Y2 To OX1,OY1,4,4
End If
End If
Next
Next
Return
AREAEARTH:
F=0
X=Free
For Y=-256 To 256 Step ST3
OX1=0 : OY1=0 : OX2=0 : OY2=0
OX3=0 : OY3=0 : OX4=0 : OY4=0
For X=WX To 1024+WX Step ST3
R= Extension_8_1114(Y,100)
XX= Extension_8_1106(X,R) : ZZ= Extension_8_1114(X,R)
YY= Extension_8_1106(Y,100)
Z2= Extension_8_11C4(XX,YY,ZZ)-DZ
X2= Extension_8_1168 +160
Y2= Extension_8_1184 +128
If Y<>-248
R= Extension_8_1114(Y-ST3,100)
XX= Extension_8_1106(X,R) : ZZ= Extension_8_1114(X,R)
YY= Extension_8_1106(Y-ST3,100)
OZ2= Extension_8_11C4(XX,YY,ZZ)-DZ
OX3= Extension_8_1168 +160
OY3= Extension_8_1184 +128
End If
If OX1 or OY1
If Z2<0 and OZ2<0
SBUF$(F)= Extension_8_08C4(512-Z2)+ Extension_8_08C4(X2)+ Extension_8_08C4(Y2)+ Extension_8_08C4(OX3)+ Extension_8_08C4(OY3)+ Extension_8_08C4(OX4)+ Extension_8_08C4(OY4)+ Extension_8_08C4(OX1)+ Extension_8_08C4(OY1)
Inc F
End If
End If
OX1=X2 : OY1=Y2
OX4=OX3 : OY4=OY3
Next
Next
X=Free
For A=F To MAS : SBUF$(A)= Extension_8_08C4(32678) : Next
Sort SBUF$(0)
Set Pattern 2
For A=0 To F-1
AD=Varptr(SBUF$(A))
Z2=512-Deek(AD) : C=-Z2/7
X1=Deek(AD+2) : Y1=Deek(AD+4) : X2=Deek(AD+6) : Y2=Deek(AD+8)
X3=Deek(AD+10) : Y3=Deek(AD+12) : X4=Deek(AD+14) : Y4=Deek(AD+16)
Ink C/2,(C+1)/2 : Polygon X1,Y1 To X2,Y2 To X3,Y3 To X4,Y4
Next
Return